(defun adjunt (a b)
  (+ (* a (expt 10 (digits-no b))) b))

(defun valid-combine(a b)
;  (format t "test ~d ~d ~%" a b)
  (and (primep (adjunt a b))
       (primep (adjunt b a))))

(defun valid-list-combine(no &optional (no2 (cdr no)))
  (cond ((null (cadr no)) t)
	((null no2) (valid-list-combine (cdr no)))
	(t (and (valid-combine (car no) (car no2)) (valid-list-combine no (cdr no2))))))

(defun next-prime(n)
  (if (primep (+ 2 n)) 
      (+ 2 n)
      (next-prime(+ 2 n))))
      
(defun find-pairs(max &optional(i 3) (j 5))
  (cond ((>= (+ 2 i) max) ())
	((>= j max) (let ((np (next-prime (+ 2 i))))
		      (find-pairs max np (next-prime (+ 2 np)))))
	((valid-combine i j) (cons (list i j) (find-pairs max i (next-prime j))))
	(t (find-pairs max i (next-prime j)))))

;--------------------search using backtracking
(defun find-first-in-list(n l)
  (cond ((null l) nil)
	((= (car (car l)) n) l)
	(T (find-first-in-list n (cdr l)))))

(defun find-next-in-list(n l)
  (cond ((null l) nil)
	((> (car (car l)) n) l)
	(T (find-next-in-list n (cdr l)))))

(defun is-valid-pair(a b)
  (or (= (car a) (car b)) (= (car a) (cadr b))
      (= (cadr a) (car b)) (= (cadr a) (cadr b))))

(defun is-valid-solution(l)
  (cond ((or (null l) (null (cdr l)))  t)
	(t (and (is-valid-pair (car (car l)) (car (cadr l))) (is-valid-solution (cdr l))))))

(defun fill-solution(l size)
  (cond ((zerop size) ())
	(t (cons l (fill-solution (find-next-in-list (car (car l)) l) (1- size))))))

(defun next-sol (l sol &optional (size (length sol)))
;  (if (> size (length sol))(print (list (mapcar #'car sol) size (length sol))))
  (cond ((null sol) nil) ;no more solutions
	((null (cdr (car sol)))  (next-sol l (cdr sol) size))
	((> size (length sol)) (cons (find-next-in-list (caaar sol) l) (next-sol l sol (1- size))))
	(T (cons (cdr (car sol)) (cdr sol)))))
  
(defun find-in-pairs(l size &optional (sol (fill-solution l size)))
  (cond ((or (null sol) (is-valid-solution sol)) (mapcar #'car sol))
	(t (find-in-pairs l size (reverse (next-sol l (reverse sol)))))))
	
  
;(require 'memoize)
;(memoize:MEMOIZE-FUNCTION 'primep)
;(memoize:MEMOIZE-FUNCTION 'next-prime)
(defvar all-no (find-pairs 1000))
(defvar first-sol (fill-solution all-no 5))


;-------dissed the pair attempt
(defun next-solution(sol max size)
  ;(print sol)
  (if (= 1 (length sol)) (print sol))
  (cond ((null sol) nil)
	((< max (car sol)) (cons (next-prime (cadr sol)) (cddr sol)))
	((> size (length sol)) (cons (next-prime (car sol)) sol))
	(t (cons (next-prime (car sol)) (cdr sol)))))

(defun search-solution(size &optional (sol '(3)) (max 10000))
  (cond ((or (null sol) (and (= size (length sol)) (valid-list-combine sol))) sol)
	((not (valid-list-combine sol)) (search-solution size (next-solution sol max (length sol))))
	(t (search-solution size (next-solution sol max size)))))